0.1 Introduction

In this Rmarkdown we are going to plot panels D, G & H. In this script we will use the Visium data coming from spatial_analysis/05-sc_mapping/07-sc_mapping_viz.Rmd and the scRNAseq data from sc_analysis/04-annotation/07-join_annotation.Rmd.

0.2 Libraries

library(Seurat)
library(ggpubr)
library(cowplot)
library(dplyr)
library(ggplot2)
library(RColorBrewer)
library(glue)
library(stringr)
library(readr)

0.3 Setting parameters

Loading necessary paths and parameters

set.seed(123)
source(here::here("misc/paths.R"))
source(here::here("utils/bin.R"))

"{fig_pt}/{plt_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(
    path = .,
    showWarnings = FALSE,
    recursive = TRUE)

"{fig_pt}/{robj_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(
    path = .,
    showWarnings = FALSE,
    recursive = TRUE)

SpatialColors <- colorRampPalette(colors = rev(x = brewer.pal(n = 11, name = "Spectral")))

0.4 Load data

Load Visum and scRNAseq data

# 07-sc_mapping_viz.Rmd
# se_obj <- "{map_27}/{robj_dir}/se_deconv_{sample_id}_epid20_pre-rotation.rds"

sp_ls <- lapply(id_sp_df$gem_id, function(id) {

  se_obj <- "{map_27}/{robj_dir}/se_deconv_{id}_epid20.rds" %>%
    glue::glue() %>%
    here::here() %>%
    readRDS(file = .)

  return(se_obj)
})

se_obj <- merge(sp_ls[[1]], y = sp_ls[2:length(sp_ls)],
                add.cell.ids = id_sp_df$gem_id,
                project = "Gloria-Salva")

# *sc_analysis/04-annotation/07-join_annotation.Rmd
sc_obj <- "{anot_28}/{robj_dir}/harmony_se_annot.rds" %>%
  glue::glue() %>%
  here::here() %>%
  readRDS(file = .)

0.5 Panels

0.5.1 Panel D

In this panel we show the UMAP with the all cell identity populations

panel_d <- Seurat::DimPlot(
  object = sc_obj,
  group.by = c("specific_annot")) +
  ggplot2::labs(title = "")

panel_d

"{fig_pt}/{plt_dir}/Main_Figure3-D.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = panel_d,
    base_height = 8,
    base_width = 12)

0.5.2 Panel F

In this panel we show genes of interest on the cell identity’s of interest.

mask_remove <- ! sc_obj$specific_annot %in% c("Proliferating Basal Cells",
                                              "Basal Cells", "Erithrocytes")
panel_f <- Seurat::FeaturePlot(
  object = sc_obj[, mask_remove],
  features =  c(
    "Apod", # Nerve regeneration
    "Nrep", # Nerve regeneration
    "Ncam1", # Non-myelinating-Immature Schwann cells
    "Vcan", # Extracellular matrix / Perineuronal net constituent
    "Has1", # Extracellular matrix / Perineuronal net constituent
    "Tnc" # Extracellular matrix / Perineuronal net constituent
    ),
  ncol = 3, pt.size = 0.25) &
  ggplot2::scale_color_gradient(
    low = "yellow",
    high = "red")

panel_f

"{fig_pt}/{plt_dir}/Main_Figure3-F.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = panel_f,
    base_height = 8,
    base_width = 12)

0.5.3 Panel G

In this panel we want to show the mouse % along with the predicted proportion of tumour-associated Schwann cells in the Visium slides.

row1 <- Seurat::SpatialPlot(
  object = se_obj,
  features = c("Tumour-associated Schwann Cells"),
  images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
  crop = FALSE,
  pt.size.factor = 1.25,
  image.alpha = 0) &
  ggplot2::scale_fill_gradientn(
    colours = SpatialColors(n = 100),
    limits = c(0, max(se_obj$`Tumour-associated Schwann Cells`)))

row1_mod <- ggpubr::ggarrange(row1[[1]], row1[[2]], row1[[3]], row1[[4]],
                              ncol = 4, common.legend = TRUE, legend = "right")
row1_mod

row2 <- Seurat::SpatialPlot(
  object = se_obj,
  features = c("percent.mouse"),
  images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
  crop = FALSE,
  pt.size.factor = 1.25,
  image.alpha = 0) &
  ggplot2::scale_fill_gradientn(
    colours = SpatialColors(n = 100),
    limits = c(0, 1))

row2_mod <- ggpubr::ggarrange(row2[[1]], row2[[2]], row2[[3]], row2[[4]],
                              ncol = 4, common.legend = TRUE, legend = "right")
row2_mod

"{fig_pt}/{plt_dir}/Main_Figure3-G1.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = row1_mod,
    base_height = 4,
    base_width = 16)


"{fig_pt}/{plt_dir}/Main_Figure3-G2.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = row2_mod,
    base_height = 4,
    base_width = 16)

0.5.4 Panel H

In this panel we want to show genes of interest in the spatial slides

plt_ls <- lapply(c("GRCh38-CD36", "mm10---Vcan", "mm10---Tnn"), function(feat) {
  
  tmp <- Seurat::SpatialPlot(
  object = se_obj,
  features = feat,
  images = c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv"),
  crop = FALSE,
  pt.size.factor = 1.25,
  image.alpha = 0) &
  ggplot2::scale_fill_gradientn(
    colours = SpatialColors(n = 100),
    limits = c(0, max(se_obj@assays$Spatial@data[feat, ])))

  tmp <- ggpubr::ggarrange(
    tmp[[1]], tmp[[2]], tmp[[3]], tmp[[4]],
    ncol = 4, common.legend = TRUE, legend = "right")

})

panel_h <- cowplot::plot_grid(
  plotlist = plt_ls,
  align = "hv",
  axis = "trbl",
  nrow = 3)

panel_h

"{fig_pt}/{plt_dir}/Main_Figure3-H.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = panel_h,
    base_height = 12,
    base_width = 16)

0.6 Session Info

sessionInfo()
## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
## 
## Matrix products: default
## BLAS:   /usr/local/lib/R/lib/libRblas.so
## LAPACK: /usr/local/lib/R/lib/libRlapack.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=es_ES.UTF-8        LC_COLLATE=en_US.UTF-8     LC_MONETARY=es_ES.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=es_ES.UTF-8       LC_NAME=C                  LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] readr_1.4.0        stringr_1.4.0      glue_1.4.2         RColorBrewer_1.1-2 dplyr_1.0.6        cowplot_1.1.1      ggpubr_0.4.0       ggplot2_3.3.3      SeuratObject_4.0.1 Seurat_4.0.2       BiocStyle_2.18.1  
## 
## loaded via a namespace (and not attached):
##   [1] readxl_1.3.1          backports_1.2.1       plyr_1.8.6            igraph_1.2.6          lazyeval_0.2.2        splines_4.0.4         listenv_0.8.0         scattermore_0.7       digest_0.6.27         htmltools_0.5.1.1     magick_2.7.2          fansi_0.4.2           magrittr_2.0.1        tensor_1.5            cluster_2.1.0         ROCR_1.0-11           openxlsx_4.2.3        globals_0.14.0        matrixStats_0.58.0    spatstat.sparse_2.0-0 colorspace_2.0-1      ggrepel_0.9.1         haven_2.4.1           xfun_0.23             crayon_1.4.1          jsonlite_1.7.2        spatstat.data_2.1-0   survival_3.2-7        zoo_1.8-9             polyclip_1.10-0       gtable_0.3.0          leiden_0.3.8          car_3.0-10            future.apply_1.7.0    abind_1.4-5           scales_1.1.1          DBI_1.1.1             rstatix_0.7.0         miniUI_0.1.1.1        Rcpp_1.0.6            viridisLite_0.4.0     xtable_1.8-4          reticulate_1.20       spatstat.core_2.1-2   foreign_0.8-81        htmlwidgets_1.5.3     httr_1.4.2            ellipsis_0.3.2        ica_1.0-2             farver_2.1.0          pkgconfig_2.0.3       sass_0.4.0            uwot_0.1.10           deldir_0.2-10        
##  [55] utf8_1.2.1            here_1.0.1            labeling_0.4.2        tidyselect_1.1.1      rlang_0.4.11          reshape2_1.4.4        later_1.2.0           munsell_0.5.0         cellranger_1.1.0      tools_4.0.4           cli_2.5.0             generics_0.1.0        broom_0.7.6           ggridges_0.5.3        evaluate_0.14         fastmap_1.1.0         yaml_2.2.1            goftest_1.2-2         knitr_1.33            fitdistrplus_1.1-3    zip_2.1.1             purrr_0.3.4           RANN_2.6.1            pbapply_1.4-3         future_1.21.0         nlme_3.1-152          mime_0.10             compiler_4.0.4        rstudioapi_0.13       plotly_4.9.3          curl_4.3.1            png_0.1-7             ggsignif_0.6.1        spatstat.utils_2.1-0  tibble_3.1.2          bslib_0.2.5.1         stringi_1.6.2         highr_0.9             ps_1.6.0              forcats_0.5.1         lattice_0.20-41       Matrix_1.3-3          vctrs_0.3.8           pillar_1.6.1          lifecycle_1.0.0       BiocManager_1.30.15   spatstat.geom_2.1-0   lmtest_0.9-38         jquerylib_0.1.4       RcppAnnoy_0.0.18      data.table_1.14.0     irlba_2.3.3           httpuv_1.6.1          patchwork_1.1.1      
## [109] R6_2.5.0              bookdown_0.22         promises_1.2.0.1      KernSmooth_2.23-18    gridExtra_2.3         rio_0.5.26            parallelly_1.25.0     codetools_0.2-18      MASS_7.3-53           assertthat_0.2.1      rprojroot_2.0.2       withr_2.4.2           sctransform_0.3.2     mgcv_1.8-33           parallel_4.0.4        hms_1.1.0             grid_4.0.4            rpart_4.1-15          tidyr_1.1.3           rmarkdown_2.8         carData_3.0-4         Rtsne_0.15            shiny_1.6.0